home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS11.ADF / AmigaBasicProgs / PointerEd / PEditor.BAS < prev    next >
BASIC Source File  |  1986-08-05  |  14KB  |  664 lines
  1. '
  2. ' Pointer Image Editor
  3. '
  4. ' Copyright 1986 By Stephen R. Pietrowicz
  5. '
  6. ' The author places this software in the 
  7. ' public domain.  Please refer to the Amazing
  8. ' Computing article accompanying this program
  9. ' for more information.
  10. '
  11. ' Please do not remove this copyright notice.
  12. '
  13. DECLARE FUNCTION AllocMem&() LIBRARY
  14. DECLARE FUNCTION FreeMem&() LIBRARY
  15. DECLARE FUNCTION ReadPixel&() LIBRARY
  16.  
  17. LIBRARY "exec.library"
  18. LIBRARY "intuition.library"
  19. LIBRARY "graphics.library"
  20. SCREEN 3,320,200,5,1
  21. WINDOW 3,"Pointer Image Editor by SR Pietrowicz",(0,0)-(309,186),0,3
  22.  
  23. GOSUB SetUp
  24. '
  25. ' Main loop:  Wait until the mouse is clicked
  26. ' to do anything.
  27. '
  28. Top:
  29.    WHILE MOUSE(0) = 0:WEND
  30.    x1 = MOUSE(3):y1 = MOUSE(4)
  31.    IF (x1 > 143) THEN CheckDial
  32.    IF (y1 > 143) THEN CheckColor
  33.    x1 = INT(x1/9):y1 = INT(y1/9)
  34.    x2 = x1*9+1: y2 = y1*9+1
  35.    IF cn = 0 THEN
  36.       Ncn = 0
  37.    ELSE
  38.       Ncn = cn+5
  39.    END IF
  40. '
  41. ' Set points in both windows, and make sure
  42. ' that the "hot spot" stays visible
  43. '    
  44.    LINE(x2,y2)-(x2+8,y2+8),Ncn,bf
  45.    PSET(180+x1,Dial+y1),Ncn
  46.    IF (PFlag = 1) AND (x1 = Psx) AND (y1 = Psy) THEN
  47.        LINE (x2+1,y2+1)-(x2+7,y2+7),11,bf
  48.    END IF
  49. '
  50. ' Set the color that was just set in the bitmap
  51. '   
  52.    IF x1 = 0 THEN
  53.       Bit% = &H8000
  54.    ELSE
  55.       Bit% = (2^(15-x1))
  56.    END IF
  57.    
  58.    Sety = Dial-2+y1
  59.  
  60.    IF (cn/2 = INT(cn/2)) THEN
  61.       Sa%(Sety,0) = Sa%(Sety,0) AND NOT Bit%
  62.    ELSE
  63.       Sa%(Sety,0) = Sa%(Sety,0) OR Bit%
  64.    END IF
  65.    IF (cn < 2) THEN
  66.       Sa%(Sety,1) = Sa%(Sety,1) AND NOT Bit%
  67.    ELSE
  68.       Sa%(Sety,1) = Sa%(Sety,1) OR Bit%
  69.    END IF
  70.         
  71.    WHILE MOUSE(0) <> 0:WEND
  72. GOTO Top
  73. '
  74. ' Move the dial, and redraw the pointer window
  75. '
  76. CheckDial:
  77.    IF (x1 < 152) THEN Top
  78.    IF (x1 > 163) THEN CheckRGB
  79.    MENU OFF
  80.    Dbox = Dial
  81. DialTop:
  82.    WHILE MOUSE(0) <> 0
  83.       Dy = MOUSE(6) 
  84.       IF (Dy<2) OR (Dy>141) THEN DialTop
  85.       IF (Dy = Dial) THEN DialTop
  86.       LINE (152,Dial)-(163,Dial+2),0,bf 
  87.       LINE (203,Dial)-(203,Dial+15),0
  88.       Dial = Dy
  89.       LINE (152,Dial)-(163,Dial+2),1,bf
  90.       LINE (203,Dial)-(203,Dial+15),1
  91.    WEND
  92.    IF (Dbox = Dial) THEN 
  93.        MENU ON
  94.        GOTO Top
  95.    END IF
  96. '
  97. ' Redraw the pointer window
  98. '
  99. PointRedraw:
  100.    FOR r = 0 TO 15
  101.        By = r*9+1
  102.        Dly = Dial+r
  103.        FOR s = 0 TO 15
  104.            Bx = s*9+1            
  105.            LINE(Bx,By)-(Bx+8,By+8),1,bf
  106.            LINE(Bx,By)-(Bx+8,By+8),POINT(180+s,Dly),bf
  107.        NEXT s
  108.    NEXT r
  109. '
  110. ' Check to see if the "Hot Spot" goes in this window
  111. '
  112.    IF LFlag = 1 THEN
  113.       RETURN
  114.    END IF
  115.    IF (Psx >= 0) THEN
  116.       IF (ABS(Dial - Psd) >= 0) AND (ABS(Dial - Psd) <= 15) THEN
  117.           Psy = Psy-(Dial-Psd)
  118.           Psd = Dial
  119.           IF (Psy >= 0) AND (Psy <= 15) THEN
  120.               NPsx = Psx*9+2
  121.               NPsy = Psy*9+2
  122.               LINE(NPsx,NPsy)-(NPsx+6,NPsy+6),11,bf
  123.               PFlag = 1
  124.           ELSE
  125.               PFlag = 0
  126.           END IF
  127.       END IF
  128.   END IF
  129.   MENU ON
  130.   GOTO Top 
  131. '
  132. ' Change the color that is being used
  133. '       
  134. CheckColor:
  135.    IF (y1 < 150) OR (y1 > 170) THEN Top
  136.    cn = INT(x1/36)
  137.    LINE (225,Rl)-(240,Rl),0
  138.    LINE (255,Gl)-(270,Gl),0
  139.    LINE (285,Bl)-(300,Bl),0
  140.    IF cn = 0 THEN
  141.       LINE (1,176)-(143,184),0,bf
  142.       Rl = 110:Gl = 110:Bl = 110
  143.    ELSE
  144.       LINE (1,176)-(143,184),cn+5,bf
  145.       Rl = 110 - (RGB!(cn,1)*100)
  146.       Gl = 110 - (RGB!(cn,2)*100)
  147.       Bl = 110 - (RGB!(cn,3)*100)
  148.    END IF
  149.    LINE (225,Rl)-(240,Rl),11
  150.    LINE (255,Gl)-(270,Gl),11
  151.    LINE (285,Bl)-(300,Bl),11
  152.    WHILE MOUSE(0) <> 0 :WEND   
  153. GOTO Top   
  154. '
  155. ' Change the Red, Green, Blue values of the
  156. ' current color
  157. '
  158. CheckRGB:
  159.     IF (cn = 0) THEN Top
  160.     IF (x1 < 225) OR (x1 > 300) THEN Top
  161.     MENU OFF    
  162.     IF (x1 >= 225) AND (x1 <= 240) THEN Red
  163.     IF (x1 >= 255) AND (x1 <= 270) THEN Green
  164.     IF (x1 >= 285) AND (x1 <= 300) THEN Blue
  165.     MENU OFF
  166.     GOTO Top
  167. Red:
  168.     WHILE MOUSE(0) <> 0
  169.        Ry = MOUSE(6)
  170.        IF (Ry < 10) OR (Ry > 110) THEN Red
  171.        IF (Ry = Rl) THEN Red
  172.        LINE(225,Rl)-(240,Rl),0
  173.        Rl = Ry
  174.        LINE(225,Rl)-(240,Rl),11
  175.        RGB!(cn,1) = (110-Rl)/100
  176.        PALETTE 5+cn, RGB!(cn,1),RGB!(cn,2),RGB!(cn,3)
  177.     WEND
  178.     GOTO EndRGB 
  179. Green:
  180.     WHILE MOUSE(0) <> 0
  181.        Gy = MOUSE(6)
  182.        IF (Gy < 10) OR (Gy > 110) THEN Green
  183.        IF (Gy = Gl) THEN Green
  184.        LINE(255,Gl)-(270,Gl),0       
  185.        Gl = Gy
  186.        LINE(255,Gl)-(270,Gl),11
  187.        RGB!(cn,2) = (110-Gl)/100
  188.        PALETTE 5+cn, RGB!(cn,1),RGB!(cn,2),RGB!(cn,3)
  189.     WEND
  190.     GOTO EndRGB 
  191. Blue:
  192.     WHILE MOUSE(0) <> 0
  193.        By = MOUSE(6)
  194.        IF (By < 10) OR (By > 110) THEN Blue
  195.        IF (By = Bl) THEN Blue
  196.        LINE (285,Bl)-(300,Bl),0
  197.        Bl = By
  198.        LINE (285,Bl)-(300,Bl),11
  199.        RGB!(cn,3) = (110-Bl)/100
  200.        PALETTE 5+cn, RGB!(cn,1),RGB!(cn,2),RGB!(cn,3)
  201.     WEND
  202. EndRGB:
  203.     MENU ON     
  204. GOTO Top
  205. '
  206. ' Initialize data structures and 
  207. ' variables used by the program
  208. '
  209. SetUp:
  210.  
  211. TotalHeight% = 156
  212. DIM Sa%(TotalHeight%,1)
  213. DIM RGB!(3,3)
  214. LFlag = 0
  215. '
  216. ' Memory allocation has to be 4 times
  217. ' the height of the pointer image.
  218. ' The second parameter to AllocMem()
  219. ' must be 2, to allocate memory in
  220. ' the first 512K of memory.
  221. '
  222. MemLength% = TotalHeight% * 4
  223. si& = AllocMem&(MemLength%,2&)
  224. IF si& = 0 THEN
  225.    PRINT "Couldn't allocate memory"
  226.    GOTO StopIt
  227. END IF
  228. FOR i = 0 TO TotalHeight%
  229.     Sa%(i,0) = 0
  230.     Sa%(i,1) = 0
  231. NEXT i
  232. '
  233. ' Set Up Menus
  234. '
  235. MENU 1,0,1,"Editor"
  236. MENU 1,1,1,"Load  "
  237. MENU 1,2,1,"Save  "
  238. MENU 1,3,1,"Clear "
  239. MENU 1,4,1,"Quit  "
  240. MENU 2,0,1,"Pointer "
  241. MENU 2,1,1,"Test    "
  242. MENU 2,2,1,"Reset   "
  243. MENU 2,3,1,"Hot Spot"
  244. MENU 3,0,1,""
  245. MENU 4,0,1,""
  246. PALETTE 30,1,0,0
  247. Psx = 0:Psy = 0:Psd = 2:PFlag = 1
  248. LINE (2,2)-(8,8),11,bf
  249. ON MENU GOSUB CheckMenu
  250. MENU ON
  251. '
  252. ' Pointer drawing box and gadget
  253. '
  254. LINE (0,0)-(145,145),1,b
  255. LINE (150,0)-(165,145),1,b
  256. Dial = 2
  257. LINE (152,Dial)-(163,Dial+2),1,bf
  258. '
  259. ' Palette that shows how "real" pointer looks
  260. '
  261. LINE (175,0)-(201,158),1,b
  262. LINE (203,Dial)-(203,Dial+15),1
  263. '
  264. ' Draw RGB Settings
  265. '
  266. PALETTE 12,1,0,0
  267. PALETTE 13,0,1,0
  268. PALETTE 14,0,0,1
  269.  
  270. LINE (220,0)-(305,158),1,b
  271. LINE (223,9)-(242,111),1,b
  272. LINE (253,9)-(272,111),1,b
  273. LINE (283,9)-(302,111),1,b
  274. LINE (225,110)-(240,110),11
  275. LINE (255,110)-(270,110),11
  276. LINE (285,110)-(300,110),11
  277. Rl = 110:Gl = 110:Bl = 110
  278. LINE (223,113)-(242,123),12,bf
  279. LINE (253,113)-(272,123),13,bf
  280. LINE (283,113)-(302,123),14,bf
  281. LOCATE 18,32
  282. PRINT "RGB"
  283. LOCATE 19,30
  284. PRINT "Settings"
  285. '
  286. ' Color Box
  287. '
  288. PALETTE 6,1,0,0
  289. PALETTE 7,0,1,0
  290. PALETTE 8,0,0,1
  291. RGB!(1,1) = 1:RGB!(1,2) = 0:RGB!(1,3) = 0
  292. RGB!(2,1) = 0:RGB!(2,2) = 1:RGB!(2,3) = 0
  293. RGB!(3,1) = 0:RGB!(3,2) = 0:RGB!(3,3) = 1
  294.  
  295. LINE (0,150)-(36,170),1,b
  296. FOR i = 1 TO 3
  297. LINE (i*36,150)-((i+1)*36,170),5+i,bf
  298. NEXT i
  299. LINE (0,175)-(144,185),1,b
  300. '
  301. ' Change the system pointer to the
  302. ' default program pointer
  303. '
  304. DefaultPointer:
  305. RESTORE
  306. '
  307. ' Default program pointer data
  308. '
  309. DATA 14
  310. DATA -1024,0,30720,-32768,12288,-16384
  311. DATA 6144,-8192,3072,-4096,1536,-10240
  312. DATA 768,-29696,384,1536,192,768
  313. DATA 96,384,48,192,24,96
  314. DATA 12,48,4,24,0,8
  315.  
  316. rp& = WINDOW(7)
  317.  
  318. READ Ap%
  319. POKEW si&,0
  320. POKEW si&+2,0
  321.  
  322. Padd = 4
  323. FOR i = 1 TO (Ap%+1)*2
  324.     READ p1%
  325.     POKEW si&+Padd, p1%
  326.     Padd = Padd + 2
  327. NEXT i
  328. POKEW si&+Padd, 0
  329. POKEW si&+Padd+2 ,0
  330.  
  331. PALETTE 17,1,0,0
  332. PALETTE 18,.6,0,0
  333. PALETTE 19,0,.6,.8
  334.  
  335. HotX% = 0
  336. HotY% = 0
  337. CALL SetPointer(rp&, si&, Ap%+1,16,HotX%,HotY%)
  338. RETURN    
  339. '
  340. ' Menu functions 
  341. '
  342. CheckMenu:
  343.  
  344. id   = MENU(0)
  345. item = MENU(1)
  346. MENU OFF
  347. '
  348. ' Editor
  349. '
  350. IF id = 1 THEN
  351. '
  352. ' Load pointer from a file
  353. '
  354.    IF item = 1 THEN
  355.      FileName$ = ""
  356.      GOSUB GetFileName
  357.      IF FileName$ = "" THEN LoadDone
  358.      GOSUB ClearImage
  359.   
  360.      OPEN FileName$ FOR INPUT AS #1
  361.          INPUT #1,RGB!(1,1),RGB!(1,2),RGB!(1,3)
  362.          INPUT #1,RGB!(2,1),RGB!(2,2),RGB!(2,3)
  363.          INPUT #1,RGB!(3,1),RGB!(3,2),RGB!(3,3)
  364.          INPUT #1,Ap%
  365.          FOR j = 0 TO Ap%
  366.              INPUT #1,Sa%(j,0),Sa%(j,1)
  367.          NEXT j
  368.          INPUT #1,Psx, Psy
  369.      CLOSE #1
  370.      Psx = -Psx
  371.      Psy = -Psy
  372.      Psd = INT(Psy/16)*16+2
  373.      Psy = Psy-Psd+2     
  374.  
  375.      PALETTE 6,RGB!(1,1),RGB!(1,2),RGB!(1,3)
  376.      PALETTE 7,RGB!(2,1),RGB!(2,2),RGB!(2,3)
  377.      PALETTE 8,RGB!(3,1),RGB!(3,2),RGB!(3,3)
  378.          
  379.      IF (Psd+Psy <= 15) THEN
  380.          PFlag = 1
  381.      ELSE
  382.          PFlag = 0
  383.      END IF
  384. '
  385. ' Reconstruct the colors, and draw them in the palette
  386. '
  387.      FOR Scan = 0 TO Ap%
  388.         Bit% = &H8000
  389.         Bit0% = (Sa%(Scan,0) AND &H8000)/&H8000
  390.         Bit1% = (Sa%(Scan,1) AND &H8000)/&H8000
  391.         cn = (Bit1%*2) OR Bit0%          
  392.         IF cn = 0 THEN
  393.            Ncn = 0
  394.         ELSE
  395.            Ncn = cn+5
  396.         END IF
  397.         PSET(180,Scan+2),Ncn
  398.         FOR j = 14 TO 0 STEP -1
  399.             Bit% = (2^j)
  400.             Bit0% = (Sa%(Scan,0) AND Bit%)/Bit%
  401.             Bit1% = (Sa%(Scan,1) AND Bit%)/Bit%
  402.             cn = (Bit1%*2) OR Bit0%          
  403.             IF cn = 0 THEN
  404.                Ncn = 0
  405.             ELSE
  406.                Ncn = cn+5
  407.             END IF
  408.             PSET(195-j,Scan+2),1
  409.             PSET(195-j,Scan+2),Ncn
  410.         NEXT j
  411.      NEXT Scan
  412. '
  413. ' Recontruct the main drawing area
  414. ' and reset the intuition pointer
  415. '
  416.      LFlag = 1
  417.      GOSUB PointRedraw
  418.      IF (PFlag = 1) THEN
  419.          LINE (Psx*9+2,Psy*9+2)-(Psx*9+8,Psy*9+8),11,bf
  420.      END IF
  421.      LFlag = 0
  422. LoadDone:     
  423.      MENU ON
  424.      RETURN
  425.    END IF
  426. '
  427. ' Save current pointer to a file
  428. '   
  429.    IF item = 2 THEN
  430. '
  431. ' Make sure there is a pointer to save...
  432. '      
  433.      Ap% = 156
  434.      PSFlag = 1
  435.      WHILE  (PSFlag = 1)
  436.          IF (Ap% < 0) THEN
  437.              PSFlag = 0
  438.          ELSEIF (Sa%(Ap%,0) <> 0) OR (Sa%(Ap%,1) <> 0) THEN
  439.              PSFlag = 0
  440.          ELSE 
  441.              Ap% = Ap% - 1
  442.          END IF
  443.      WEND
  444.      IF (Ap% < 0) THEN
  445.         LOCATE 21,20
  446.         PRINT "No pointer! Hit ESC "
  447.         GOTO SaveBad
  448.      END IF
  449.  
  450.      FileName$ = ""
  451.      GOSUB GetFileName
  452.      IF FileName$ = "" THEN SaveDone
  453.      
  454.      OPEN FileName$ FOR OUTPUT AS #1
  455.          WRITE #1,RGB!(1,1),RGB!(1,2),RGB!(1,3)
  456.          WRITE #1,RGB!(2,1),RGB!(2,2),RGB!(2,3)
  457.          WRITE #1,RGB!(3,1),RGB!(3,2),RGB!(3,3)
  458.          WRITE #1,Ap%
  459.          FOR j = 0 TO Ap%
  460.              WRITE #1,Sa%(j,0),Sa%(j,1)
  461.          NEXT j
  462.          WRITE #1,-Psx, -(Psy+Psd-2)
  463.      CLOSE #1
  464.      GOTO SaveDone
  465. SaveBad:
  466.      Key$ = INKEY$: IF Key$ = "" THEN SaveBad
  467.      IF ASC(Key$) <> 27 THEN SaveBad
  468.      LOCATE 21,20
  469.      PRINT "                    "  
  470. SaveDone:     
  471.      MENU ON
  472.      RETURN
  473.    END IF
  474. '
  475. ' Clear current pointer bitmap and drawing areas 
  476. '
  477.  
  478.    IF item = 3 THEN
  479. ClearImage:
  480.       FOR i = 0 TO 156
  481.          Sa%(i,0) = 0
  482.          Sa%(i,1) = 0
  483.       NEXT i
  484.       LINE (1,1)-(144,144),0,bf
  485.       LINE (152,Dial)-(163,Dial+2),0,bf 
  486.       LINE (152,2)-(163,4),1,bf
  487.       LINE (203,Dial)-(203,Dial+15),0
  488.       Dial = 2
  489.       LINE (176,1)-(200,157),0,bf
  490.       LINE (203,2)-(203,17),1
  491.       Psx = 0:Psy = 0:Psd = 2:PFlag = 1
  492.       LINE (2,2)-(8,8),11,bf
  493.       MENU ON
  494.       RETURN
  495.    END IF
  496. '
  497. ' Quit
  498. '
  499.    IF item = 4 THEN
  500.       GOTO StopIt
  501.    END IF
  502. END IF
  503. '
  504. ' Pointer functions
  505. '
  506. IF id = 2 THEN
  507. '
  508. ' Use the current pointer image
  509. '
  510.    IF item = 1 THEN
  511.       GOSUB SetIt
  512.       MENU ON
  513.       RETURN
  514.    END IF
  515. '
  516. ' Reset the pointer in use to the default pointer
  517. '
  518.    IF item = 2 THEN
  519.       GOSUB DefaultPointer 
  520.       MENU ON
  521.       RETURN
  522.    END IF
  523. '
  524. ' Set the pointer's "Hot Spot"
  525. '
  526.    IF item = 3 THEN
  527. PickSet:
  528.       WHILE MOUSE(0) = 0:WEND
  529.       x1 = MOUSE(3):y1 = MOUSE(4)
  530.       IF x1>143 OR y1>143 THEN PickSet
  531.       x1 = INT(x1/9):y1 = INT(y1/9)
  532.       x2 = x1*9+2: y2 = y1*9+2
  533.       IF (PFlag = 1) THEN
  534.          NPsx = Psx*9+2
  535.          NPsy = Psy*9+2
  536.          Pc = POINT(NPsx-1,NPsy-1)
  537.          IF (Pc <> 0) THEN
  538.              LINE(NPsx,NPsy)-(NPsx+6,NPsy+6),Pc,bf
  539.          ELSE
  540.              LINE(NPsx,NPsy)-(NPsx+6,NPsy+6),0,bf
  541.          END IF
  542.       END IF
  543.       LINE(x2,y2)-(x2+6,y2+6),11,bf
  544.       Psx = x1
  545.       Psy = y1
  546.       Psd = Dial
  547.       PFlag = 1
  548.       WHILE MOUSE(0) <> 0:WEND
  549.       ON MENU GOSUB CheckMenu
  550.       MENU ON
  551.       RETURN
  552.    END IF
  553. END IF
  554.  
  555. RETURN
  556.  
  557. END
  558. '
  559. ' Subroutine to return FileName$
  560. '   FileName$ is limited to 17 characters
  561. '   Hitting the escape key exits with a
  562. '   NULL value
  563. '
  564. GetFileName:
  565.    LOCATE 21,20
  566.    PRINT "Input file Name:"
  567.    LINE(150,173)-(300,185),1,b
  568.    
  569.    Key$ = INKEY$
  570.    WHILE Key$<>"":Key$ = INKEY$:WEND
  571.    
  572.    Box = 152
  573.    LINE(Box,175)-(Box+7,183),30,bf
  574.    Cursor = 20
  575.    LOCATE 23,Cursor
  576. NameTop:
  577.    Key$ = INKEY$:IF Key$ = "" THEN NameTop
  578.    NameLen = LEN(FileName$)
  579.    IF (ASC(Key$) = 27) THEN 
  580.        FileName$ = ""
  581.        GOTO NameDone
  582.    END IF
  583.    IF (ASC(Key$) = 13) AND (NameLen <>0) THEN NameDone
  584.    IF (ASC(Key$) =  8) AND (NameLen > 0) THEN
  585.        FileName$ = LEFT$(FileName$,NameLen-1)
  586.        LINE (Box,175)-(Box+7,183),0,bf
  587.        Box = Box-8
  588.        LINE (Box,175)-(Box+7,183),30,bf
  589.        GOTO NameTop
  590.    END IF
  591.    IF (NameLen >= 17) THEN NameTop
  592.    IF ((Key$ >= "0") AND (Key$ <= "9")) THEN NameAdd
  593.    IF ((Key$ >= "A") AND (Key$ <= "Z")) THEN NameAdd
  594.    IF ((Key$ >= "a") AND (Key$ <= "z")) THEN NameAdd
  595.    GOTO NameTop
  596. NameAdd:
  597.    FileName$ = FileName$ + Key$
  598.    LINE (Box,175)-(Box+7,183),0,bf
  599.    LOCATE 23,20+NameLen
  600.    PRINT Key$;
  601.    Box = Box+8
  602.    LINE (Box,175)-(Box+7,183),30,bf
  603.    GOTO NameTop
  604.    
  605. NameDone: 
  606.    LOCATE 21,20
  607.    PRINT "                "
  608.    LINE(150,173)-(300,185),0,bf
  609. RETURN
  610. END
  611. '
  612. ' User the pointer image on the palette as
  613. ' the default pointer
  614. '
  615. SetIt:
  616.      Ap% = 156
  617.      PSFlag = 1
  618.      WHILE  (PSFlag = 1)
  619.          IF (Ap% < 0) THEN
  620.              PSFlag = 0
  621.          ELSEIF (Sa%(Ap%,0) <> 0) OR (Sa%(Ap%,1) <> 0) THEN
  622.              PSFlag = 0
  623.          ELSE
  624.              Ap% = Ap% - 1
  625.          END IF
  626.      WEND
  627. IF (Ap% < 0) THEN
  628.     RETURN
  629. END IF
  630.     
  631. POKEW si&, 0
  632. POKEW si&+2, 0
  633.  
  634. Padd = 4
  635. FOR j = 0 TO Ap%+1
  636.    POKEW (si&+Padd), Sa%(j,0)
  637.    Padd = Padd + 2
  638.    POKEW (si&+Padd), Sa%(j,1)
  639.    Padd = Padd + 2
  640. NEXT j
  641. POKEW si&+Padd, 0
  642. POKEW si&+Padd+2 ,0
  643.  
  644. PALETTE 17,RGB!(1,1),RGB!(1,2),RGB!(1,3)
  645. PALETTE 18,RGB!(2,1),RGB!(2,2),RGB!(2,3)
  646. PALETTE 19,RGB!(3,1),RGB!(3,2),RGB!(3,3)
  647.  
  648. Spx% = -Psx: Spy% = -(Psy+Psd-2)
  649. CALL SetPointer(rp&, si&, Ap%+2,16,Spx%,Spy%)
  650. RETURN
  651. '
  652. ' Clean up the loose ends, and exit 
  653. '
  654. StopIt:
  655.  
  656. WINDOW CLOSE 3
  657. SCREEN CLOSE 3
  658.  
  659. CALL FreeMem(si&,MemLength%)
  660.  
  661. LIBRARY CLOSE
  662.  
  663. END
  664.